home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / MODEMPRO / HOST110.ZIP;1 / HOSTDOS.SCR < prev    next >
Encoding:
Text File  |  1994-05-14  |  9.3 KB  |  354 lines
  1. ' DOS Shell
  2. '
  3. 'DO NOT COMPILE THIS FILE BY ITSELF!
  4. '
  5. 'This file is a part of the complete HOST.SCR and will not compile
  6. 'alone.  To recompile the host scripts, select Scripts/Compile from
  7. 'the QmodemPro for Windows menu and select HOST.SCR in the "Compile
  8. 'script" dialog box.  This file will automatically be compiled as
  9. 'part of the full script.
  10.  
  11. function MakePrompt(prompt as string) as string
  12.   dim res as string, s as string
  13.   do while prompt <> ""
  14.     if left(prompt, 1) = "$" then
  15.       prompt = right(prompt, len(prompt)-1)
  16.       select case OemUpper(left(prompt, 1))
  17.         case "$"
  18.           s = "$"
  19.         case "B"
  20.           s = "|"
  21.         case "D"
  22.           s = date
  23.         case "E"
  24.           s = ESC
  25.         case "G"
  26.           s = ">"
  27.         case "H"
  28.           s = BS+" "+BS
  29.         case "L"
  30.           s = "<"
  31.         case "N"
  32.           s = curdrive
  33.         case "P"
  34.           s = curdir
  35.         case "Q"
  36.           s = "="
  37.         case "T"
  38.           s = time
  39.         case "V"
  40.           s = "version"
  41.         case "_"
  42.           s = CR+LF
  43.         case else
  44.           s = "$" + left(prompt, 1)
  45.       end select
  46.       res = res + s
  47.     else
  48.       res = res + left(prompt, 1)
  49.     end if
  50.     prompt = right(prompt, len(prompt)-1)
  51.   loop
  52.   MakePrompt = res
  53. end function
  54.  
  55. sub DosShellDir(fn as string)
  56.   dim sr as SearchRec
  57.   dim result as integer
  58.   dim i as integer, count as integer
  59.   dim dir as string
  60.   if fn = "" then
  61.     fn = "*.*"
  62.   end if
  63.   dir = JustPathname(fn)
  64.   if len(dir) = 0 then
  65.     dir = AddBackSlash(CurDir)
  66.   else
  67.     dir = AddBackSlash(dir)
  68.   end if
  69.   send #Port,
  70.   send #Port, " Volume in drive "; CurDrive;
  71.   result = FindFirst("\*.*", 8, sr)
  72.   if result = 0 then
  73.     send #Port, " is ", sr.name
  74.   else
  75.     send #Port, " has no label"
  76.   end if
  77.   send #Port, " Directory of "; dir
  78.   send #Port,
  79.   count = 0
  80.   result = FindFirst(fn, 16, sr)
  81.   if result = 0 then
  82.     do
  83.       i = instr(sr.name, ".")
  84.       if i > 0 then
  85.         send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
  86.       else
  87.         send #Port, sr.name; tab(14);
  88.       end if
  89.       if (sr.attribute and 16) <> 0 then
  90.         send #Port, " <DIR>     ";
  91.       else
  92.         send #Port, space(11-len(str(sr.size))); sr.size;
  93.       end if
  94.       send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
  95.       send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
  96.       send #Port,
  97.       count = count + 1
  98.       if count >= 24 then
  99.         if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
  100.           exit do
  101.         end if
  102.         count = 0
  103.       end if
  104.       result = FindNext(sr)
  105.     loop while result = 0
  106.   else
  107.     send #Port, "File not found"
  108.   end if
  109. end sub
  110.  
  111. type buffertype
  112.   data(1024) as byte
  113. end type
  114.  
  115. sub DosShellCopy(src as string, dest as string)
  116.   dim inf as integer, outf as integer
  117.   inf = freefile
  118.   open src for random as #inf len = len(buffertype)
  119.   outf = freefile
  120.   open dest for append as #outf len = len(buffertype)
  121.   close outf
  122.   open dest for random as #outf len = len(buffertype)
  123.   dim buf as buffertype
  124.   dim recs as long
  125.   recs = 0
  126.   do while not eof(inf)
  127.     get #inf, , buf
  128.     put #outf, , buf
  129.     recs = recs + 1
  130.   loop
  131.   close inf
  132.   close outf
  133.   open src for random as #inf len = 1
  134.   open dest for random as #outf len = 1
  135.   seek #inf, (recs - 1) * len(buffertype) + 1
  136.   seek #outf, (recs - 1) * len(buffertype) + 1
  137.   do while not eof(inf)
  138.     get #inf, , buf
  139.     put #outf, , buf
  140.   loop
  141.   close inf
  142.   close outf
  143. end sub
  144.  
  145. sub ChangeDir
  146.   dim prompt as string
  147.   if User.Level = 0 or Setup.Sysopanypath = 0 then
  148.     send #Port, "Sorry, Changing directory not available at this access level."
  149.     send #Port, "Leave a MSG to the Sysop if this option is desired."
  150.     send #Port,
  151.     exit sub
  152.   end if
  153.   prompt = environ("PROMPT")
  154.   if prompt = "" then
  155.     prompt = "$P$G"
  156.   end if
  157.   send #Port, "Put a space between CD and \ when making a directory change."
  158.   send #Port, "Current directory is:"
  159. goagain:
  160.   do
  161.     send #Port,
  162.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  163.     cmdline = ltrim(rtrim(getLine(MakePrompt((prompt)))))
  164.     cmd = OemUpper(NextField(cmdline, " "))
  165.     for i = 1 to 10
  166.       arg(i) = NextField(cmdline, " ")
  167.     next i
  168.     select case cmd
  169.       case "CD", "CHDIR"
  170.          if arg(1) = "" then
  171.             send #Port, curdir
  172.          else
  173.             chdir arg(1)
  174.          end if
  175.       case "DIR"
  176.            DosShellDir(arg(1))
  177.       case "EXIT"
  178.          exit do
  179.       case "A:"
  180.              send #Port, "Floppy drive A cannot be accessed."
  181.       case "B:"
  182.              send #Port, "Floppy drive B cannot be accessed."
  183.       case is <> ""
  184.          if len(cmd) = 2 and right(cmd, 1) = ":" then
  185.              chdrive left(cmd, 1)
  186.              send #Port, "Current directory is:"
  187.              send #Port, curdir
  188.          else
  189.              send #Port, "Change drive using C: or D: etc."
  190.              send #Port, "Put a space between CD and \ when making a directory change."
  191.          end if
  192.       case ""
  193.           exit do
  194.    end select
  195.   loop until CallerHungUp
  196. catch err_path
  197.    send #Port, "Error in directory"
  198.    goto goagain
  199. end sub
  200.  
  201. sub DosShell
  202.   dim prompt as string, origdir as string
  203.   if User.Level = 0 or Setup.dospass = "" then
  204.     send #Port, "Sorry, drop to DOS not available at this access level."
  205.     send #Port,
  206.     exit sub
  207.   end if
  208.   if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
  209.     send #Port,
  210.     send #Port, "Wrong password entered."
  211.     send #Port,
  212.     exit sub
  213.   end if
  214.   prompt = environ("PROMPT")
  215.   if prompt = "" then
  216.     prompt = "$P$G"
  217.   end if
  218.   origdir = curdir
  219. goagain:
  220.   do
  221.     send #Port,
  222.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  223.     cmdline = ltrim(rtrim(GetLine(MakePrompt((prompt)))))
  224.     cmd = OemUpper(NextField(cmdline, " "))
  225.     for i = 1 to 10
  226.       arg(i) = NextField(cmdline, " ")
  227.     next i
  228.     select case cmd
  229.       case "CD", "CHDIR"
  230.         if arg(1) = "" then
  231.           send #Port, curdir
  232.         else
  233.           chdir arg(1)
  234.         end if
  235.       case "CLS"
  236.         send #Port, chr(27)+"[2H"+chr(27)+"[2J";
  237.         cls
  238.       case "COPY"
  239.         if arg(1) <> "" and arg(2) <> "" then
  240.           if exists(arg(1)) then
  241.             if exists(arg(2)) then
  242.               send #Port, "Destination file "; arg(2); " already exists"
  243.             else
  244.               DosShellCopy arg(1), arg(2)
  245.             end if
  246.           else
  247.             send #Port, "Source file "; arg(1); " does not exist"
  248.           end if
  249.         end if
  250.       case "DATE"
  251.         send #Port, Date
  252.       case "DEL", "ERASE"
  253.         if arg(1) <> "" then
  254.           dim sr as SearchRec
  255.           dim result as integer
  256.           result = findfirst(arg(1), 0, sr)
  257.           do while result = 0
  258.             dim s as string
  259.             s = JustPathname(arg(1))
  260.             if len(s) > 0 then
  261.               del AddBackSlash(s)+sr.name
  262.             else
  263.               del sr.name
  264.             end if
  265.             result = findnext(sr)
  266.           loop
  267.           del arg(1) '!! wildcards
  268.         else
  269.           send #Port, "Filename expected"
  270.         end if
  271.       case "DIR"
  272.         DosShellDir(arg(1))
  273.       case "EXIT"
  274.         exit do
  275.       case "HELP"
  276.         if not DisplayFile("hostdos.hlp") then
  277.           send #Port, "No help available"
  278.         end if
  279.       case "MD", "MKDIR"
  280.         if arg(1) <> "" then
  281.           mkdir arg(1)
  282.         else
  283.           send #Port, "Directory expected"
  284.         end if
  285.       case "MOVE"
  286.         if arg(1) <> "" and arg(2) <> "" then
  287.           if exists(arg(1)) then
  288.             if exists(arg(2)) then
  289.               send #Port, "Destination file "; arg(2); " already exists"
  290.             else
  291.               name arg(1) as arg(2)
  292.             end if
  293.           else
  294.             send #Port, "Source file "; arg(1); " does not exist"
  295.           end if
  296.         end if
  297.       case "PROMPT"
  298.         if arg(1) = "" then
  299.           send #Port, prompt
  300.         else
  301.           prompt = arg(1)
  302.         end if
  303.       case "RD", "RMDIR"
  304.         if arg(1) <> "" then
  305.           rmdir arg(1)
  306.         else
  307.           send #Port, "Directory expected"
  308.         end if
  309.       case "REN", "RENAME"
  310.         if arg(1) <> "" and arg(2) <> "" then
  311.           name arg(1) as arg(2)
  312.         else
  313.           send #Port, "Two filenames expected"
  314.         end if
  315.       case "TIME"
  316.         send #Port, Time
  317.       case "TYPE"
  318.         if arg(1) <> "" then
  319.           DisplayFile arg(1)
  320.         else
  321.           send #Port, "Filename expected"
  322.         end if
  323.       case "VER"
  324.         send #Port, "QmodemPro for Windows "; version; " DOS shell"
  325.       case is <> ""
  326.         if len(cmd) = 2 and right(cmd, 1) = ":" then
  327.           chdrive left(cmd, 1)
  328.         else
  329.           send #Port, "Bad command or file name"
  330.         end if
  331.     end select
  332.   loop until CallerHungUp
  333.   chdrive origdir
  334.   chdir origdir
  335.  
  336. catch err_fileopen
  337.   send #Port, "Error opening file"
  338.   goto goagain
  339. catch err_path
  340.   send #Port, "Error in directory"
  341.   goto goagain
  342. catch err_filerename
  343.   send #Port, "Error renaming file"
  344.   goto goagain
  345. end sub
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.